home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok31.lha / Pute / Pute.imp < prev    next >
Text File  |  1993-08-15  |  4KB  |  181 lines
  1. (*-------------------------------------------------------------------------
  2.  
  3.   :Program.   Pute
  4.   :Contents.  Kleiner CLI-Taschenrechner
  5.   :Version.   V1.0, Dezember 89, Fridtjof Siebert
  6.   :Author.    Fridtjof Siebert
  7.   :Address.   Nobileweg 67, D-7000 Suttgart 40
  8.   :CopyRight. PD
  9.   :Language.  OBERON
  10.   :Compiler.  AMOK OBORON Compiler, V0.2 beta
  11.  
  12. ---------------------------------------------------------------------------*)
  13.  
  14. DEFINITION Pute; END Pute.
  15.  
  16. IMPLEMENTATION Pute;
  17.  
  18. (* $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- *)
  19.  
  20. IMPORT io, ol: OberonLib;
  21.  
  22. CONST
  23.   lparen = 0; rparen = 1; times  = 2; plus   = 3; minus  = 4;
  24.   div    = 5; mod    = 6; number = 7; eof    = -1;
  25.  
  26. TYPE
  27.   String = ARRAY 80 OF CHAR;
  28.  
  29. VAR
  30.   Sym: SHORTINT;
  31.   Number: LONGINT;
  32.   Char: CHAR;
  33.   buffer: POINTER TO String;
  34.   index: INTEGER;
  35.   Identifier: String;
  36.   result: LONGINT;
  37.  
  38. (*-------------------------------------------------------------------------*)
  39.  
  40. PROCEDURE ReadChar;
  41.  
  42. BEGIN
  43.   IF index=ol.dosCmdLen THEN
  44.     Char := 0X;
  45.   ELSE
  46.     Char := CAP(buffer^[index]); INC(index)
  47.   END;
  48. END ReadChar;
  49.  
  50. (*-------------------------------------------------------------------------*)
  51.  
  52. PROCEDURE Error;
  53.  
  54. BEGIN
  55.   io.WriteString("Usage: PUTE <Expression>"); io.WriteLn; HALT(0)
  56. END Error;
  57.  
  58. (*-------------------------------------------------------------------------*)
  59.  
  60. PROCEDURE GetSym();
  61.  
  62. VAR
  63.   digit: String;    (* used to read constant numbers *)
  64.   cnt,i: INTEGER;
  65.   n: SHORTINT;
  66.  
  67. BEGIN
  68.   WHILE (Char<=" ") AND (Char>0X) DO ReadChar END;
  69.   CASE Char OF
  70.   "A".."Z":
  71.     cnt := 0;
  72.     WHILE (Char>="A") AND (Char<="Z") DO
  73.       Identifier[cnt] := Char;
  74.       ReadChar;
  75.       INC(cnt); IF cnt=80 THEN Error END;
  76.     END;
  77.     Identifier[cnt] := 0X;
  78.     IF    Identifier="DIV" THEN Sym := div
  79.     ELSIF Identifier="MOD" THEN Sym := mod
  80.     ELSE Error END |
  81.   "0".."9":
  82.     cnt := -1;
  83.     WHILE ((Char>="0") AND (Char<="9")) OR ((Char>="A") AND (Char<="Z")) DO
  84.       INC(cnt);
  85.       IF cnt=80 THEN Error END;
  86.       digit[cnt] := Char;
  87.       ReadChar;
  88.     END;
  89.     Number := 0; i := 0;
  90.     IF digit[cnt]#"H" THEN
  91.       WHILE i<=cnt DO
  92.         n := SHORTINT(digit[i])-SHORTINT("0");
  93.         CASE n OF 0..9: Number := 10 * Number + n ELSE Error END;
  94.         INC(i);
  95.       END;
  96.     ELSE
  97.       WHILE i<cnt DO
  98.         n := SHORTINT(digit[i])-SHORTINT("0");
  99.         IF n>9 THEN DEC(n,7) END;
  100.         CASE n OF 0..15: Number := 16 * Number + n ELSE Error END;
  101.         INC(i);
  102.       END;
  103.     END;
  104.     Sym := number;
  105.     RETURN |
  106.   "(": Sym := lparen |
  107.   ")": Sym := rparen |
  108.   "*": Sym := times  |
  109.   "+": Sym := plus   |
  110.   "-": Sym := minus  |
  111.   "/": Sym := div    |
  112.   0X : Sym := eof    |
  113.   ELSE Error END;
  114.   ReadChar;
  115. END GetSym;
  116.  
  117. (*-------------------------------------------------------------------------*)
  118.  
  119. PROCEDURE Expression(): LONGINT;
  120.  
  121. VAR
  122.   c: LONGINT;
  123.   addOperator: SHORTINT;
  124.  
  125.   PROCEDURE Term(): LONGINT;
  126.  
  127.   VAR
  128.     d,c: LONGINT;
  129.     s: SHORTINT;
  130.  
  131.     PROCEDURE Factor(): LONGINT;
  132.     VAR c: LONGINT;
  133.     BEGIN
  134.       CASE Sym OF number: c := Number; GetSym |
  135.                   lparen: GetSym; c:=Expression();
  136.                           IF Sym#rparen THEN Error END;
  137.                           GetSym |
  138.       ELSE Error END;
  139.       RETURN c
  140.     END Factor;
  141.  
  142.   BEGIN
  143.     c := Factor();
  144.     LOOP
  145.       CASE Sym OF
  146.       times,div,mod:
  147.         s := Sym;
  148.         GetSym; d := Factor();
  149.         IF s=times  THEN c := c * d;
  150.         ELSIF d=0   THEN HALT(0)
  151.         ELSIF s=div THEN c := c DIV d;
  152.                     ELSE c := c MOD d END |
  153.       ELSE EXIT END;
  154.     END;
  155.     RETURN c;
  156.   END Term;
  157.  
  158. BEGIN
  159.   addOperator := Sym;
  160.   IF (addOperator=plus) OR (addOperator=minus) THEN GetSym END;
  161.   c := Term();
  162.   IF addOperator=minus THEN c := -c END;
  163.   LOOP
  164.     CASE Sym OF
  165.     plus : GetSym; INC(c,Term()) |
  166.     minus: GetSym; DEC(c,Term()) |
  167.     ELSE EXIT END;
  168.   END;
  169.   RETURN c;
  170. END Expression;
  171.  
  172. BEGIN
  173.   IF ol.wbStarted THEN Error END;
  174.   buffer := ol.dosCmdBuf;
  175.   Char := " "; GetSym;
  176.   result := Expression(); IF Sym#eof THEN Error END;
  177.   io.WriteInt(result,11); io.WriteString(" = ");
  178.   io.WriteHex(result,8); io.Write("H"); io.WriteLn;
  179. END Pute.
  180.  
  181.